perm filename TEST1V.SAI[SAI,BGB] blob sn#028610 filedate 1973-11-17 generic text, type T, neo UTF8
00100	BEGIN	"TEST1V"
00200		REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00300		REQUIRE "RANDOM[SYS,BGB]" LOAD_MODULE;
00400		EXTERNAL REAL PROCEDURE RANDOM;
00500		REQUIRE "SAITRG[SYS,BGB]" SOURCE_FILE;
00600		EXTERNAL ITG PROCEDURE LS1V3P(REAL ARRAY V,P1,P2,P3,V3P);
00700	
00800	α WORKING SPACE AND NAMINGS;
00900		INTEGER NROOTS,II,I;
01000		REAL L2,L3,R,RMIN,RXY,ERR,ERRMAX;
01100		REAL ARRAY P1,P2,P3,V3P[1:3],V[1:10,1:3];
01200		DEFINE X1="P1[1]",X2="P2[1]",X3="P3[1]";
01300		DEFINE Y2="P2[2]",Y3="P3[2]",Z3="P3[3]";
01400	
01500	REAL PROCEDURE VERIFY (REAL X,Y,Z);
01600	BEGIN	"VERIFY"
01700		DEFINE THRICE = "FOR I←1 STEP 1 UNTIL 3 DO";
01800		INTEGER I;
01900		REAL LA,LB,LC,CA,CB,CC;
02000		REAL ARRAY ALEG,BLEG,CLEG,L[1:3];
02100		L[1]←X;L[2]←Y;L[3]←Z;
02200		THRICE ALEG[I] ← P3[I] - L[I];
02300		THRICE BLEG[I] ← P1[I] - L[I];
02400		THRICE CLEG[I] ← P2[I] - L[I];
02500		LA	←	SQRT(ALEG[1]↑2 + ALEG[2]↑2 + ALEG[3]↑2);
02600		LB	←	SQRT(BLEG[1]↑2 + BLEG[2]↑2 + BLEG[3]↑2);
02700		LC	←	SQRT(CLEG[1]↑2 + CLEG[2]↑2 + CLEG[3]↑2);
02800	   CA ← (BLEG[1]*CLEG[1]+BLEG[2]*CLEG[2]+BLEG[3]*CLEG[3])/(LB*LC);
02900	   CB ← (ALEG[1]*CLEG[1]+ALEG[2]*CLEG[2]+ALEG[3]*CLEG[3])/(LA*LC);
03000	   CC ← (ALEG[1]*BLEG[1]+ALEG[2]*BLEG[2]+ALEG[3]*BLEG[3])/(LA*LB);
03100		ERR ← (ABS(CA-V3P[1]) + ABS(CB-V3P[2]) + ABS(CC-V3P[3]))/3;
03200		RETURN(ERR);
03300	END	"VERIFY";
     

00100	α EXERCISE LOOP;
00200		FOR II←1 STEP 1 UNTIL 100 DO
00300	BEGIN	"FOREVER"
00400		INTEGER TIME0,TIME1,TIMES;
00500	
00600	α GENERATE A LANDMARK TRIANGLE;
00700		X1	←	20*RANDOM + 1;
00800		X2	←	20*RANDOM + 1;
00900		Y2	←	20*RANDOM + 1;
01000		X3	←	20*RANDOM + 1;
01100		Y3	←	20*RANDOM + 1;
01200		Z3	←	20*RANDOM + 1;
01300	
01400	α COMPUTE THE COSINES AT THE CAMERA;
01500		L2	←	SQRT(X2↑2 + Y2↑2);
01600		L3	←	SQRT(X3↑2 + Y3↑2 + Z3↑2);
01700		V3P[3]	←	X2 / L2;
01800		V3P[1]	←	(X2*X3+Y2*Y3)/ (L2*L3);
01900		V3P[2]	←	X3 / L3;
02000		V3P[2]↔V3P[3];V3P[1]↔V3P[2];
02100	
02200	α THROW THE SHIT AT THE FAN;
02300		NROOTS	←	LS1V3P (V,P3,P1,P2,V3P);
02400		RMIN	←	1000;
02500	
02600	α OUTPUT THE RESULTS;
02700		IF NROOTS < 0 THEN OUTSTR("	NO ROOTS  -  GAP LOW.") ELSE
02800		IF NROOTS = 0 THEN OUTSTR("	NO ROOTS  -  GAP HIGH") ELSE
02900		FOR I←1 STEP 1 UNTIL NROOTS DO
03000		RMIN	← RMIN MIN SQRT(V[I,1]↑2+V[I,2]↑2+V[I,3]↑2);
03100		OUTSTR(CVG(RMIN)&9);
03200		IF RMIN>0.1  THEN 
03300		⊂ OUTSTR("LOSE"&↓);INCHRW;⊃
03400		ELSE OUTSTR("WIN"&↓);
03500	END	"FOREVER";
03600	END	"TEST1V"